home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pas_0593.zip / FILLGRID.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-30  |  7KB  |  227 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 219 of 773
  3. From : Herb Brown                          1:396/11.0           04 May 93  10:13
  4. To   : All
  5. Subj : hex map grid solution
  6. ────────────────────────────────────────────────────────────────────────────────}
  7. program fillgrid;
  8.  
  9. { example of filling a hex sided grid with data about itself and it's
  10.   neighbors. }
  11.  
  12. uses dos,
  13.      crt;  { only for debugging }
  14.  
  15. const MaxRows = 7;
  16.       MaxColumns = 5;
  17.       MaxHex = 32;   { only used for array and testing }
  18.  
  19.  type grid = record
  20.        id : longint;
  21.        nw : longint;
  22.        ne : longint;
  23.         w : longint;
  24.         e : longint;
  25.        se : longint;
  26.        sw : longint;
  27.      TerrainRec : Longint;  { can be used as a reference to a database}
  28.      end;
  29.  
  30.   var GridVar : Array [1..MaxHex] of grid;
  31.       gridCounter : Longint;
  32.       RowCounter,ColCounter,EndColumn : Longint;
  33.       OddRow, finished : Boolean;
  34.       CurrentGrid : grid;
  35.       x : integer;
  36.  
  37.  
  38. procedure getit(ColCounter,
  39.                 RowCounter,
  40.                 GridCounter,
  41.                 MaxColumns,
  42.                 MaxRows         : Longint;
  43.                 var CurrentGrid : grid);
  44.  
  45. begin
  46. CurrentGrid.id:=gridcounter;
  47.  
  48.  (* The 9 possible cases tested *)
  49.  
  50.     { Middle tested first for speed because there are more
  51.       of these in large maps }
  52.  
  53.      {middle}
  54.      if ((colcounter > 1) and (colcounter < EndColumn)) then
  55.       if  (rowcounter <> 1) and (rowcounter <> maxrows)   then
  56.       begin
  57.         CurrentGrid.nw := (gridcounter-MaxColumns);  { }
  58.         CurrentGrid.w  := (gridcounter-1);
  59.         CurrentGrid.sw := (gridcounter+MaxColumns)-1;
  60.         CurrentGrid.se := gridcounter+maxColumns;
  61.         CurrentGrid.e  := gridcounter+1;
  62.         CurrentGrid.ne := (gridcounter-MaxColumns)+1;
  63.       exit;
  64.       end;
  65.  
  66.    {leftedge}
  67.        if (colcounter = 1) and (rowcounter <> 1) then
  68.        if (rowcounter <> maxrows) then
  69.          begin
  70.             if oddrow then
  71.              CurrentGrid.nw := (gridcounter-MaxColumns)
  72.             else
  73.              CurrentGrid.nw := 0;   { }
  74.              CurrentGrid.w  := 0;
  75.             if oddrow then
  76.              CurrentGrid.sw := (gridcounter+MaxColumns)-1
  77.             else
  78.              CurrentGrid.sw := 0;
  79.             CurrentGrid.se  := gridcounter+maxColumns;
  80.             CurrentGrid.e   := gridcounter+1;
  81.             CurrentGrid.ne  := (gridcounter-MaxColumns)+1;
  82.          exit;
  83.          end;
  84.  
  85.    {rightedge}
  86.       if (colcounter = EndColumn) and (rowcounter <> 1) then
  87.        if (rowcounter <> maxrows) then
  88.           begin
  89.             CurrentGrid.nw := (gridcounter-MaxColumns);
  90.             CurrentGrid.w  := (gridcounter-1);
  91.             CurrentGrid.sw := (gridcounter+MaxColumns)-1;
  92.            if oddrow then
  93.             CurrentGrid.se := gridcounter+maxColumns
  94.            else
  95.             CurrentGrid.se := 0;
  96.             CurrentGrid.e  := 0;
  97.            if oddrow then
  98.             CurrentGrid.ne := (gridcounter-MaxColumns)+1
  99.            else
  100.             CurrentGrid.ne := 0;
  101.            exit;
  102.           end;
  103.  
  104.  
  105.      {toprow}
  106.        if (rowcounter = 1) and (colcounter <> 1) then
  107.         if (colcounter <> maxcolumns) then
  108.         begin
  109.             CurrentGrid.nw := 0;
  110.             CurrentGrid.w  := (gridcounter-1);
  111.             CurrentGrid.sw := (gridcounter+MaxColumns)-1;
  112.             CurrentGrid.se := gridcounter+maxColumns;
  113.             CurrentGrid.e  := gridcounter+1;
  114.             CurrentGrid.ne := 0;
  115.         exit;
  116.         end;
  117.  
  118.    {BottomRow}
  119.     if (rowcounter = maxrows) and (colcounter <> 1) then
  120.     if (colcounter <> maxcolumns)  then
  121.      begin
  122.             CurrentGrid.nw := (gridcounter-MaxColumns);
  123.             CurrentGrid.w  := (gridcounter-1);
  124.             CurrentGrid.sw := 0;
  125.             CurrentGrid.se := 0;
  126.             CurrentGrid.e  := gridcounter+1;
  127.             CurrentGrid.ne := (gridcounter-MaxColumns)+1;
  128.       exit;
  129.      end;
  130.  
  131.  
  132.      {TopLeftCorner}
  133.        if (colcounter = 1) and (rowcounter = 1) then
  134.            begin
  135.             CurrentGrid.nw := 0;  { Can't leave edge! }
  136.             CurrentGrid.w  := 0;
  137.             CurrentGrid.sw := 0;
  138.             CurrentGrid.se := gridcounter+maxColumns;
  139.             CurrentGrid.e  := gridcounter+1;
  140.             CurrentGrid.ne := 0;
  141.             exit;
  142.            end;
  143.  
  144.  
  145.    {toprightcorner}
  146.        if (rowcounter = 1) and (colcounter = maxcolumns) then
  147.         begin
  148.             CurrentGrid.nw := 0;
  149.             CurrentGrid.w  := (gridcounter-1);
  150.             CurrentGrid.sw := (gridcounter+MaxColumns)-1;
  151.             CurrentGrid.se := 0;
  152.             CurrentGrid.e  := 0;
  153.             CurrentGrid.ne := 0;
  154.         exit;
  155.         end;
  156.  
  157.  
  158.    {bottomleftCorner}
  159.       if (colcounter = 1) and (rowcounter = maxrows) then
  160.          begin
  161.             CurrentGrid.nw := 0;
  162.             CurrentGrid.w  := 0;
  163.             CurrentGrid.sw := 0;
  164.             CurrentGrid.se := 0;
  165.             CurrentGrid.e  := gridcounter+1;
  166.             CurrentGrid.ne := (gridcounter-MaxColumns)+1;
  167.          exit;
  168.          end;
  169.  
  170.  
  171.       {BottomRightCorner}
  172.        if (colcounter = maxcolumns) and (rowcounter = maxrows) then
  173.         begin
  174.             CurrentGrid.nw := (gridcounter-MaxColumns);
  175.             CurrentGrid.w  := (gridcounter-1);
  176.             CurrentGrid.sw := 0;
  177.             CurrentGrid.se := 0;
  178.             CurrentGrid.e  := 0;
  179.             CurrentGrid.ne := 0;
  180.           exit;
  181.         end;
  182.  
  183. end; { end of proc getit }
  184.  
  185. begin    { main Block }
  186.    { Init }
  187.  clrscr;
  188.  { fill the record array out for debugging or "watch" purposes }
  189.  { this loop was only used for debugging }
  190.  for x:=1 to MaxHex do
  191.    begin
  192.     GridVar[x].id := 0;
  193.     gridvar[x].nw := 0;
  194.     gridvar[x].ne := 0;
  195.     gridvar[x].w  := 0;
  196.     gridvar[x].e  := 0;
  197.     gridvar[x].se := 0;
  198.     gridvar[x].sw := 0;
  199.     gridVar[x].TerrainRec:=0;
  200.    end;
  201.  fillchar(CurrentGrid,sizeof(currentgrid),0);
  202.  GridCounter := 1;
  203.  RowCounter:=1;
  204.  ColCounter:=1;
  205.  Oddrow:=False;
  206.  Finished := False;
  207.  EndColumn := MaxColumns;
  208.  while not finished do
  209.   begin { while }
  210.    getit(ColCounter,RowCounter,GridCounter,MaxColumns,MaxRows,CurrentGrid);
  211.    gridvar[gridcounter]:=CurrentGrid;  { <- can be stored to a vitual array or
  212.                                          data base file here }
  213.    Inc(ColCounter);    { next grid id }
  214.    Inc(gridCounter);
  215.    if colcounter = EndColumn+1 then
  216.     begin
  217.      Oddrow := not oddrow;
  218.      ColCounter:=1;
  219.      if rowcounter = MaxRows then finished := True;
  220.      inc(rowcounter);  { next row }
  221.       if not oddrow then
  222.        EndColumn := MaxColumns
  223.       else
  224.        EndColumn := MaxColumns - 1;
  225.     end
  226.     end;
  227. end.